(defun dvs-number? (form)
  (numberp form))

(defun dvs-string? (form)
  (stringp form))

(defun dvs-self-evaluating? (form)
  (or (dvs-number? form) (dvs-string? form)))

(defun dvs-pair? (form)
  (consp form))

(defun dvs-symbol? (form)
  (symbolp form))

(defun print-fn (fn-obj stream)
  (print (cons 'fn (fn-code fn-obj)) stream))

(defstruct (fn (:print-object print-fn)) code env)

(defun dvs-fn? (form)
  (fn-p form))

(defstruct prim-fn function)

(defun print-macro (macro-obj stream)
  (print (cons 'macro (macro-code macro-obj)) stream))

(defstruct (macro (:print-object print-macro)) code env)

(defun dvs-lookup (form env)
  (let ((binding (assoc form (cdr env))))
    (if binding
	(cdr binding)
      (error (format nil "unbound variable: ~a" form)))))

(defun dvs-apply (form env)
  (cond ((eq (car form) 'quote) (cadr form))
	((eq (car form) 'define)
	 (let ((variable (second form)) (value (dvs-eval (third form) env)))
	   (if (dvs-symbol? variable) (rplacd env (cons (cons variable value) (cdr env)))
	     (error (format nil "define expects a symbol as argument 1, got ~a" variable)))
	   variable))
	((eq (car form) 'set!)
	 (let ((binding (assoc (second form) (cdr env))) (value (dvs-eval (third form) env)))
	   (if binding (rplacd binding value)
	     (error (format nil "set! requires var to be defined first: ~a not defined" (second form))))
	   (car binding)))
	((eq (car form) 'fn)
	 (make-fn :code (cdr form) :env env))
	(t (let* ((func (dvs-eval (car form) env))
		  (args (if (macro-p func) (cdr form) 
			  (mapcar #'(lambda (form) (dvs-eval form env)) (cdr form)))))
	     (cond ((prim-fn-p func) (apply (prim-fn-function func) args))
		   ((fn-p func) (error "Cannot apply deviser functions yet"))
		   ((macro-p func) (error "Cannot apply deviser macros yet"))
		   (t (error (format nil "Cannot apply ~a" form))))))))

(defun dvs-eval (form env)
  (cond ((dvs-self-evaluating? form) form)
	((dvs-symbol? form) (dvs-lookup form env))
	((dvs-pair? form) (dvs-apply form env))))

(defun dvs-make-env ()
  (list '*env*))

(defun dvs-add-to-env (env symbol value)
  (rplacd env (cons (cons symbol value) (cdr env))))

(defun dvs-standard-env ()
  (let ((env (dvs-make-env)))
    (dvs-add-to-env env 'car (make-prim-fn :function #'car))
    (dvs-add-to-env env 'cdr (make-prim-fn :function #'cdr))
    (dvs-add-to-env env 'cons (make-prim-fn :function #'cons))
    env))

(defun dvs-repl ()
  (let ((env (dvs-standard-env)))
    (do () (nil)
      (format t "~a~%" (dvs-eval (read) env)))))
